home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / arith2.com / ADP_MOD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-27  |  6.3 KB  |  230 lines
  1. UNIT adp_mod;
  2.  
  3. {$O+}
  4.  
  5.         { ------------------------------------------------------------------
  6.  
  7.           This program and its associates implement in Turbo Pascal v5
  8.           the aritmetic encoding/decoding algorithms presented in the papers
  9.  
  10.           "Arithmetic Coding for Data Compression"
  11.  
  12.                    by Ian     H. Witten
  13.                       Radford M. Neal
  14.                       John    G. Cleary
  15.  
  16.           pp 520 - 540 of June 1987 Communications of the ACM
  17.  
  18.           and
  19.  
  20.           "An Adaptive Dependency Source Model For Data Compression"
  21.  
  22.                    by David M. Abrahamson
  23.  
  24.           pp 77 - 83 of January 1989 Communications of the ACM
  25.  
  26.           ------------------------------------------------------------------
  27.  
  28.           Implemented by Ken Westerback : CompuServe 73547,3520
  29.  
  30.           version 1.0 released 89/02/19
  31.           version 2.0 released 89/02/27
  32.  
  33.           These programs, units and associated documentation are released
  34.           into the public domain to be used and abused as your whims
  35.           dictate.
  36.  
  37.           Feel free to distribute/incorporate/improve as desired.
  38.  
  39.           >>>>> Use at your own risk! <<<<<
  40.  
  41.           Comments and suggestions welcome via CompuServe.
  42.  
  43.           ------------------------------------------------------------------
  44.         }
  45.  
  46. interface
  47.  
  48.  
  49. const model_name = 'Adaptive Dependency Source Model';
  50.  
  51.  
  52. { this procedure initializes the model - must be exported cuz we }
  53. { may be overlay'ed                                              }
  54.  
  55. procedure start_model;
  56.  
  57. function  select_symbol (     ch : char    ) : integer;
  58.  
  59. function  select_char   ( symbol : integer ) : char;
  60.  
  61. procedure update_model  ( symbol : integer );
  62.  
  63.  
  64. implementation uses model_h;
  65.  
  66. const max_count  = 65535; { 2**16 - 1 }
  67.  
  68. type symbol_array = array [ 0..no_of_symbols ] of char;
  69.      char_array   = array [ 0..no_of_chars-1 ] of integer;
  70.      count_array  = array [ 0..no_of_symbols ] of 0..max_count;
  71.      ctoi_array   = array[ 0..no_of_chars-1 ] of ^char_array;
  72.      itoc_array   = array[ 0..no_of_chars-1 ] of ^symbol_array;
  73.      ctoi_p       = ^ctoi_array;
  74.      itoc_p       = ^itoc_array;
  75.  
  76. var last_ch : integer;    { previous source character }
  77.  
  78.     count   : array [ 0..no_of_chars-1 ] of ^count_array;
  79.               { character count table }
  80.  
  81.     char_to_index : ctoi_p;
  82.     index_to_char : itoc_p;
  83.  
  84.  
  85. procedure start_model;
  86.  
  87.           var ch, i : integer;
  88.  
  89.           begin
  90.  
  91.           { initialize tables for translating between symbol indicies }
  92.           { and characters                                            }
  93.  
  94.           new ( char_to_index );
  95.           new ( index_to_char );
  96.  
  97.           for ch := 0 to no_of_chars-1 do
  98.               begin
  99.  
  100.               { allocate space for array rows }
  101.  
  102.               new ( index_to_char^[ ch ] );
  103.               new ( char_to_index^[ ch ] );
  104.               new ( count[ ch ]         );
  105.  
  106.               for i := 0 to no_of_chars-1 do
  107.                   begin
  108.                   index_to_char^[ ch ]^[ i+1 ] := chr ( i );
  109.                   char_to_index^[ ch ]^[ i   ] := i + 1;
  110.                   end;
  111.  
  112.               { initialize character count table }
  113.  
  114.               for i := 1 to no_of_symbols do
  115.                   count[ ch ]^[ i ] := 0;
  116.  
  117.               count[ ch ]^[ 0 ] := max_count; { sentinel value for loop }
  118.  
  119.               end;
  120.  
  121.  
  122.           { initialize frequency and cumulative frequency tables }
  123.  
  124.           for i := 0 to no_of_symbols do
  125.               begin
  126.               cum_freq[ i ] := no_of_symbols - i;
  127.               freq[ i ] := 1;
  128.               end;
  129.  
  130.           freq[ 0 ] := 0; { sentinel value for loop }
  131.  
  132.           last_ch := $0A; { LF assumed to precede first character }
  133.  
  134.           end; { start_model }
  135.  
  136.  
  137. function select_symbol;
  138.  
  139.          begin
  140.  
  141.          select_symbol := char_to_index^[ last_ch ]^[ ord(ch) ];
  142.  
  143.          end; { select symbol }
  144.  
  145.  
  146. function select_char;
  147.  
  148.          begin
  149.  
  150.          select_char := index_to_char^[ last_ch ]^[ symbol ];
  151.  
  152.          end; { select_char }
  153.  
  154.  
  155. procedure update_model;
  156.  
  157.           var i, k, x, y, next_ch, cum : integer;
  158.                                        j : word;
  159.  
  160.  
  161.           begin
  162.  
  163.           { if the total cumulative frequency has now reached the maximum }
  164.           { allowed value, halve all counts ( keeping them non-zero )     }
  165.  
  166.           if ( cum_freq[ 0 ] = max_frequency ) then
  167.              begin
  168.              cum := 0;
  169.              for i := no_of_symbols downto 0 do
  170.                  begin
  171.                  freq[ i ] := ( freq[ i ] + 1 ) div 2;
  172.                  cum_freq[ i ] := cum;
  173.                  inc ( cum, freq [ i ] );
  174.                  end;
  175.              end;
  176.  
  177.           { select original index and count for this symbol }
  178.  
  179.           i := symbol;
  180.           j := count[ last_ch ]^[ i ];
  181.  
  182.           next_ch := ord ( index_to_char^[ last_ch ]^[ i ] );
  183.  
  184.           { if the character has moved, exchange codes }
  185.  
  186.           while ( j = count[ last_ch ]^[ i-1 ] ) do
  187.                 begin
  188.                 k := ord ( index_to_char^[ last_ch ]^[ i-1 ] );
  189.                 index_to_char^[ last_ch ]^[ i ] := chr (k);
  190.                 char_to_index^[ last_ch ]^[ k ] := i;
  191.                 dec ( i );
  192.                 end;
  193.  
  194.           { if necessary reposition the symbol }
  195.  
  196.           if ( i < symbol ) then
  197.              begin
  198.              index_to_char^[ last_ch ]^[ i ] := chr ( next_ch );
  199.              char_to_index^[ last_ch ]^[ next_ch ] := i;
  200.              end;
  201.  
  202.           { increment frequency and character counts }
  203.  
  204.           inc ( freq[ i ] );
  205.           inc ( count[ last_ch ]^[ i ] );
  206.  
  207.           { if character count has reached the maximum value allowed, }
  208.           { halve all counts                                          }
  209.  
  210.           if ( count[ last_ch ]^[ i ] = max_count ) then
  211.              for x := 0 to no_of_chars-1 do
  212.                  if (count[ x ] <> NIL) then
  213.                     for y := 1 to no_of_symbols do
  214.                         count[ x ]^[ y ] := count[ x ]^[ y ] div 2;
  215.  
  216.           { update cumulative frequencies }
  217.  
  218.           while ( i > 0 ) do
  219.                 begin
  220.                 dec ( i );
  221.                 inc ( cum_freq[ i ] );
  222.                 end;
  223.  
  224.           last_ch := next_ch;
  225.  
  226.           end; { update_model }
  227.  
  228.  
  229. end. { Adaptive Dependency Model }
  230.